home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / files.mod (.txt) < prev    next >
Oberon Text  |  1996-06-10  |  24KB  |  764 lines

  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. StampElems
  6. Alloc
  7. 10 Jun 96
  8. Syntax10b.Scn.Fnt
  9. (* AMIGA *)
  10. MODULE Files;  (* shml/cn 16.12.1992 Oberon files mapped onto AmigaDOS files, 
  11.     NOTE
  12.         This module is built on the assumption, that it never holds
  13.         an exclusive lock on any of its open files. Only temporary
  14.         files used within a single procedure (like in rename) may
  15.         be opend exclusively, but have to be closed before the
  16.         procedure termination.
  17. IMPORT
  18.     SYSTEM,Amiga,Dos:=AmigaDos,I:=AmigaIntuition,Kernel;
  19. CONST
  20.     BigEndianSet=FALSE;    (* TRUE for HP,PowerOberon, FALSE for others (e.g. Amiga) *)
  21.     BigEndianMachine=TRUE;    (* 680x0 is big endian, i386 is little endian *)
  22.     nofbufs=4;
  23.     bufsize=4096;
  24.     fileTabSize=100;
  25.     noDesc=0;
  26.     (* file states *)
  27.     open=0; create=1; close=2;
  28.     (* error results *)
  29.     noError=0; directoryNotFound=1; fileNotFound=2;
  30.     FileName=ARRAY 104 OF CHAR;
  31.     File*=POINTER TO Handle;
  32.     Buffer=POINTER TO BufDesc;
  33.     FileInfoBlockPtr=POINTER TO Dos.FileInfoBlock;
  34.     workName: The name currently in use on the underlying file system.
  35.     registerName: Name to enter in the directory, if the file is registered.
  36.     fl: AmigaDos lock to the file.
  37.     fd: AmigaDos file handle to the file.
  38.     len: legth of the file.
  39.     pos: Remebers the actual position in the underlying AmigaDos file.
  40.     bufs: Buffers for the file.
  41.     swapper: Number of the last swapped out buffer.
  42.     state: see below.
  43.     idx:
  44.     When a file is opened with Old, its name is stored into workName,
  45.     registerName is empty and state becomes open. fd and fl are valid
  46.     handle and lock to the file.
  47.     When a file is created with New, its name is stored into registerName,
  48.     while workName stays empty and state becomes create. fd and fl are
  49.     not set up, as no connection to an actual file is performed at this stage.
  50.     Create will actually associate an AmigaDos file to the Oberon file when
  51.     this is needed. If the state is create, then only a temporary file is associated
  52.     to it. This follows the Oberon idea, that no directory entry is made unless
  53.     Register is called. The state close indicates to Create, that we are registering
  54.     a file which hasn't yet an association to an AmigaDos file. The register name
  55.     is thus used. In any case the file changes state to open, as now an association
  56.     is made.
  57.     Handle=RECORD
  58.         registerName:FileName;
  59.         fl:Dos.FileLockPtr;
  60.         fd:Dos.FileHandlePtr;
  61.         len,pos:LONGINT;
  62.         bufs:ARRAY nofbufs OF Buffer;
  63.         swapper,state,idx:INTEGER
  64.     END;
  65.     f: File to which this buffer belongs.
  66.     chg: TRUE if buffer content differs from the one stored in the file.
  67.     org: The offset within the underlying file which corresponds to the first byte of the buffer.
  68.     size: The numer of valid bytes in this buffer.
  69.     data: buffer space.
  70.     BufDesc=RECORD
  71.         f:File;
  72.         chg:BOOLEAN;
  73.         org,size:LONGINT;
  74.         data:ARRAY bufsize OF SYSTEM.BYTE
  75.     END;
  76.     Rider*=RECORD
  77.         res*:LONGINT;
  78.         eof*:BOOLEAN;
  79.         buf:Buffer;
  80.         org,offset:LONGINT
  81.     END;
  82.     CurrentDir-:ARRAY 256 OF CHAR;
  83.     searchPath:ARRAY 256 OF CHAR;
  84.     fileTab:ARRAY fileTabSize OF LONGINT;
  85.     startTime:LONGINT;
  86.     tempno:INTEGER;
  87. PROCEDURE^ Finalize(obj:SYSTEM.PTR);
  88. PROCEDURE SeekAndExtend(f:Dos.FileHandlePtr; newpos:LONGINT);        (*<<OJ*)
  89.     Seek to the selected position in the file, extending it
  90.     if necessary to reach this position.
  91.     pos:LONGINT;
  92. BEGIN
  93.     pos:=Dos.Seek(f,newpos,Dos.beginning);
  94.     IF pos<0 THEN
  95.             Error in seek, probably because the file was too
  96.             short. So extend the file and then seek again.
  97.         pos:=Dos.SetFileSize(f,newpos,Dos.beginning);
  98.         ASSERT(pos=newpos, 44);
  99.         pos:=Dos.Seek(f,newpos,Dos.beginning);
  100.         ASSERT(pos>=0, 45)
  101. END SeekAndExtend;
  102. PROCEDURE MakeFileName(dir,name:ARRAY OF CHAR; VAR dest:ARRAY OF CHAR);
  103. BEGIN
  104.     dest[0]:=0X;
  105.     IF Dos.AddPart(dest,dir,LEN(dest)) THEN END;
  106.     IF Dos.AddPart(dest,name,LEN(dest)) THEN END
  107. END MakeFileName;
  108. PROCEDURE GetTempName(VAR path:ARRAY OF CHAR);
  109.     Generate a new temporary file name.
  110.     n,i,c:LONGINT;
  111.     name:FileName;
  112. BEGIN
  113.     INC(tempno);
  114.     n:=tempno;
  115.     COPY(".tmp.00000000.00000",name);
  116.     i:=18;
  117.     WHILE n>0 DO
  118.         name[i]:=CHR(n MOD 10+ORD("0"));
  119.         n:=n DIV 10;
  120.         DEC(i)
  121.     END;
  122.     n:=startTime;
  123.     i := 12;
  124.     WHILE n>0 DO
  125.         c:=n MOD 16;
  126.         IF c>9 THEN INC(c,ORD("A")-ORD("9")-1) END;
  127.         name[i]:=CHR(c+ORD("0"));
  128.         n:=n DIV 16;
  129.         DEC(i)
  130.     END;
  131.     MakeFileName(CurrentDir,name,path)
  132. END GetTempName;
  133. PROCEDURE CacheEntry(fl:Dos.FileLockPtr):File;
  134.     Given an AmigaDos file lock search our open file
  135.     table, whether the file was already opened.
  136.     f:File;
  137.     i:INTEGER;
  138. BEGIN
  139.     FOR i:=0 TO fileTabSize-1 DO
  140.         f:=SYSTEM.VAL(File,fileTab[i]);
  141.         IF (f#NIL) THEN
  142.             IF Dos.SameLock(fl,f.fl)=Dos.same THEN
  143.                 RETURN f
  144.             END
  145.         END
  146.     END;
  147.     RETURN NIL
  148. END CacheEntry;
  149. PROCEDURE Rename*(old,new:ARRAY OF CHAR; VAR res:INTEGER);
  150.     Rename a file. If necessary perform a copy/delete operation,
  151.     to move the file across file systems.
  152. CONST
  153.     bufSize=4096;
  154.     fdold,fdnew:Dos.FileHandlePtr;
  155.     n,errno:LONGINT;
  156.     lock:Dos.FileLockPtr;
  157.     buf:ARRAY bufSize OF CHAR;
  158.     tmp:ARRAY 104 OF CHAR;
  159.     success:BOOLEAN;
  160. BEGIN
  161.         First locate the old file. Dos.Lock can only file, if the
  162.         file doesn't exist, or if some other program than Oberon
  163.         has it opened exclusively.
  164.     lock:=Dos.Lock(old,Dos.sharedLock);
  165.     IF lock=0 THEN
  166.         res:=fileNotFound
  167.     ELSE
  168.             Delete any file already existing with the new name.
  169.         IF ~Dos.DeleteFile(new) THEN res:=SHORT(Dos.IoErr()) ELSE res:=0 END;
  170.         IF res=Dos.objectInUse THEN
  171.             (*
  172.                 If the named file cannot be deleted, because it's
  173.                 opened, then rename it to some temporary name.
  174.             *)
  175.             GetTempName(tmp);
  176.             success:=Dos.Rename(new,tmp);
  177.             ASSERT(success,91)
  178.         END;
  179.             Now try to rename the old file to the
  180.             new name.
  181.         success:=Dos.Rename(old,new);
  182.         Dos.UnLock(lock);
  183.         IF ~success THEN
  184.             errno:=Dos.IoErr();
  185.             IF errno#Dos.renameAcrossDevices THEN
  186.                 (*
  187.                     The rename failed because of some unexpected
  188.                     reason, report this reason in res.
  189.                 *)
  190.                 res:=SHORT(errno);
  191.                 RETURN
  192.             ELSE
  193.                 (*
  194.                     The rename failed because the new name specifies a different file
  195.                     systen than the old name. The files has to be moved by a copy
  196.                     delete operation.
  197.                     NOTE
  198.                         The new files is opened exclusively, thus should guarantee its
  199.                         closure as Oberon cannot handle exclusively locked files.
  200.                 *)
  201.                 fdold:=Dos.Open(old,Dos.oldFile);
  202.                 IF fdold=0 THEN errno:=Dos.IoErr(); HALT(92) END;
  203.                 fdnew:=Dos.Open(new,Dos.newFile);
  204.                 IF fdnew=0 THEN errno:=Dos.IoErr(); HALT(93) END;
  205.                 IF Dos.SetProtection(new,{Dos.protExecute}) THEN END; (* everything but excute *)
  206.                 n:=Dos.Read(fdold,buf,bufSize);
  207.                 WHILE n>0 DO
  208.                     errno:=Dos.Write(fdnew,buf,n);
  209.                     IF errno#n THEN
  210.                         errno:=Dos.IoErr();
  211.                         IF Dos.Close(fdold) THEN END;
  212.                         IF Dos.Close(fdnew) THEN END;
  213.                         HALT(94)
  214.                     END;
  215.                     n:=Dos.Read(fdold,buf,bufSize)
  216.                 END;
  217.                 IF Dos.Close(fdold) THEN END;
  218.                 IF Dos.Close(fdnew) THEN END;
  219.                 IF Dos.DeleteFile(old) THEN END;
  220.                 res:=0
  221.             END
  222.         END;
  223.         res:=0
  224. END Rename;
  225. PROCEDURE Delete*(name:ARRAY OF CHAR; VAR res:INTEGER);
  226.     Delete a file. If it is hold by Oberon, it is renamed to a
  227.     temporary file.
  228.     f:File;
  229.     lock:Dos.FileLockPtr;
  230.     tempName:FileName;
  231. BEGIN
  232.     lock:=Dos.Lock(name,Dos.sharedLock);
  233.     IF lock=0 THEN
  234.             If we can't lock it, it either doesn't exist, or is
  235.             locked exclusively by another program.
  236.         res:=fileNotFound
  237.     ELSE
  238.         f:=CacheEntry(lock);
  239.         Dos.UnLock(lock);
  240.         IF f=NIL THEN
  241.             (*
  242.                 The file is not one of those opened by Oberon, so just delete it
  243.                 using Dos.DeleteFile.
  244.             *)
  245.             IF ~Dos.DeleteFile(name) THEN res:=SHORT(Dos.IoErr()) ELSE res:=0 END
  246.         ELSE
  247.             (*
  248.                 The file is opened by Oberon, thus we have to rename
  249.                 it to a temporary file, and not really delete it.
  250.             *)
  251.             IF ~Dos.NameFromLock(f.fl,f.registerName) THEN f.registerName:="" END;
  252.             GetTempName(tempName);
  253.             Rename(f.registerName,tempName,res);
  254.             IF res#0 THEN HALT(117) END
  255.         END
  256. END Delete;
  257. PROCEDURE Create(f:File);
  258.     err:ARRAY 25 OF CHAR;
  259.     errno:LONGINT;
  260.     fl:Dos.FileLockPtr;
  261.     i,res:INTEGER;
  262.     newName:FileName;
  263.     oldF:File;
  264.     tmpName:FileName;
  265. BEGIN
  266.     IF f.fd=noDesc THEN
  267.             We haven't yet associated an AmigaDos file to this
  268.             Oberon file.
  269.         IF f.state=create THEN
  270.             (*
  271.                 The file was "just" created (Files.New), so assign a temporary
  272.                 name to it.
  273.             *)
  274.             GetTempName(newName)
  275.         ELSIF f.state=close THEN
  276.             (*
  277.                 We are already registering the file. Let's check, if
  278.                 try to use the name of an existing file which we already
  279.                 use. If we do, then the other file is "removed" from
  280.                 the directory, i.e. it gets a temporary name.
  281.             *)
  282.             fl:=Dos.Lock(f.registerName,Dos.sharedLock);
  283.             IF fl#0 THEN
  284.                 oldF:=CacheEntry(fl);
  285.                 IF oldF#NIL THEN
  286.                     IF ~Dos.NameFromLock(oldF.fl,oldF.registerName) THEN oldF.registerName:="" END;
  287.                     GetTempName(tmpName);
  288.                     Rename(oldF.registerName,tmpName,res);
  289.                     IF res#0 THEN HALT(107) END
  290.                 END;
  291.                 Dos.UnLock(fl)
  292.             END;
  293.             newName:=f.registerName;
  294.             f.registerName:=""
  295.         END;
  296.         IF Dos.DeleteFile(newName) THEN END;
  297.         f.fd:=Dos.Open(newName,Dos.readWrite);
  298.         IF f.fd=0 THEN errno:=Dos.IoErr(); err:="create not done"; HALT(95) END;
  299.         f.fl:=0; f.idx:=-1;
  300.         Kernel.RegisterObject(f,Finalize);
  301.         IF Dos.SetProtection(newName,{Dos.protExecute}) THEN END; (* everything but excute *)
  302.         i:=0;
  303.         WHILE (i<fileTabSize) & (fileTab[i]#0) DO INC(i) END;
  304.         IF i=fileTabSize THEN
  305.             IF Dos.Close(f.fd) THEN END;
  306.             f.fd:=0;
  307.             err:="too many files open"; HALT(96)
  308.         END;
  309.         fileTab[i]:=SYSTEM.VAL(LONGINT,f); INC(Kernel.nofiles);
  310.         f.state:=open; f.pos:=0; f.fl:=Dos.DupLockFromFH(f.fd); f.idx:=i
  311. END Create;
  312. PROCEDURE Flush(buf:Buffer);
  313.     err:ARRAY 25 OF CHAR;
  314.     errno:LONGINT;
  315.     f:File;
  316.     registerName,workName:FileName;
  317. BEGIN
  318.     IF buf.chg THEN
  319.         f:=buf.f;
  320.         Create(f);
  321.         IF buf.org#f.pos THEN SeekAndExtend(f.fd,buf.org) END;
  322.         errno:=Dos.Write(f.fd,buf.data,buf.size);
  323.         IF errno#buf.size THEN
  324.             errno:=Dos.IoErr();
  325.             IF ~Dos.NameFromLock(f.fl,workName) THEN workName:="" END;
  326.             registerName:=f.registerName;
  327.             err:="error in writing file";
  328.             HALT(97)
  329.         END;
  330.         f.pos:=buf.org+buf.size;
  331.         buf.chg:=FALSE
  332. END Flush;
  333. PROCEDURE Close*(f:File);
  334.     i:INTEGER;
  335. BEGIN
  336.     IF (f.state#create) OR (f.registerName#"") THEN
  337.         Create(f);
  338.         i:=0; WHILE (i<nofbufs) & (f.bufs[i]#NIL) DO Flush(f.bufs[i]); INC(i) END
  339. END Close;
  340. PROCEDURE Length*(f:File):LONGINT;
  341. BEGIN
  342.     RETURN f.len
  343. END Length;
  344. PROCEDURE New*(name:ARRAY OF CHAR):File;
  345.     f:File;
  346. BEGIN
  347.     NEW(f); MakeFileName(CurrentDir,name,f.registerName);
  348.     f.fd:=noDesc; f.state:=create; f.len:=0; f.pos:=0; f.swapper:=-1; (*all f.buf[i]=NIL*)
  349.     RETURN f
  350. END New;
  351. PROCEDURE Old*(name:ARRAY OF CHAR):File;
  352.     f:File;
  353.     fd:Dos.FileHandlePtr;
  354.     fl:Dos.FileLockPtr;
  355.     err,path:ARRAY 256 OF CHAR;
  356.     i:INTEGER;
  357. BEGIN
  358.     IF name="" THEN
  359.         f:=NIL;    (* Can't open a file without a name. *)
  360.     ELSE
  361.         MakeFileName(CurrentDir,name,path);
  362.             First search the file in the current directory. If it
  363.             wasn't found, prepend the Oberon search path
  364.             to it, and retry.
  365.         fd:=Dos.Open(path,Dos.oldFile);
  366.         IF (fd=0) & (name[0]#":") THEN
  367.             MakeFileName(searchPath,name,path);
  368.             fd:=Dos.Open(path,Dos.oldFile)
  369.         END;
  370.         IF fd=0 THEN
  371.             f:=NIL;    (* couldn't locate the file. *)
  372.         ELSE
  373.             fl:=Dos.DupLockFromFH(fd);
  374.             f:=CacheEntry(fl);
  375.             IF f#NIL THEN
  376.                 (*
  377.                     The file is already opened, so use the
  378.                     existing file handle, and close the
  379.                     AmigaDos file.
  380.                 *)
  381.                 Dos.UnLock(fl);
  382.                 IF Dos.Close(fd) THEN END
  383.             ELSE
  384.                 (*
  385.                     A new file. locate a free slot in the file table,
  386.                     and enter the file.
  387.                 *)
  388.                 i:=0;
  389.                 WHILE (i<fileTabSize) & (fileTab[i]#0) DO INC(i) END;
  390.                 IF i=fileTabSize THEN
  391.                     IF Dos.Close(fd) THEN END;
  392.                     Dos.UnLock(fl);
  393.                     err:="too many files open";
  394.                     HALT(98)
  395.                 END;
  396.                 NEW(f); fileTab[i]:=SYSTEM.VAL(LONGINT,f); INC(Kernel.nofiles);
  397.                 f.len:=Dos.Seek(fd,0,Dos.end);
  398.                 f.len:=Dos.Seek(fd,f.len,Dos.beginning);
  399.                 f.fd:=fd; f.fl:= fl; f.idx:=i;
  400.                 Kernel.RegisterObject(f,Finalize);
  401.                 f.state:=open; f.pos:=0; f.swapper:=-1; (*all f.buf[i]=NIL*)
  402.                 f.registerName:=""
  403.             END
  404.         END
  405.     END;
  406.     RETURN f
  407. END Old;
  408. PROCEDURE Purge*(f:File);
  409.     Reduce the files size to 0.
  410.     i:INTEGER;
  411. BEGIN
  412.     FOR i:=0 TO nofbufs-1 DO
  413.         IF f.bufs[i]#NIL THEN f.bufs[i].org:=-1; f.bufs[i]:=NIL END
  414.     END;
  415.     IF (f.fd#noDesc) & (Dos.SetFileSize(f.fd,0,Dos.beginning)=0) THEN END;
  416.     f.pos:=0; f.len:=0; f.swapper:=-1
  417. END Purge;
  418. PROCEDURE GetDate*(f:File; VAR t,d:LONGINT);
  419.     Get a files date.
  420.     fib:FileInfoBlockPtr;
  421.     sec,min,hour,days,mday,mon,year:LONGINT;
  422. BEGIN
  423.     Create(f); NEW(fib);
  424.     IF Dos.Examine(f.fl,fib^) THEN
  425.         sec:=fib.date.tick DIV Dos.ticksPerSecond;
  426.         min:=fib.date.minute MOD 60;
  427.         hour:=fib.date.minute DIV 60;
  428.         t:=sec+ASH(min,6)+ASH(hour,12);
  429.         days:=fib.date.days+28430; (* Days between 1.1.1978 and 1.3.1900 *)
  430.         year:=(4*days+3) DIV 1461;
  431.         DEC(days,1461*year DIV 4);
  432.         mon:=(5*days+2) DIV 153;
  433.         mday:=days-(153*days+2) DIV 5 +1;
  434.         INC(mon,3);
  435.         IF mon>12 THEN INC(year); DEC(mon,12) END;
  436.         d:=mday+ASH(mon,5)+ASH(year MOD 100,9)
  437.     ELSE
  438.         t:=0; d:=0
  439. END GetDate;
  440. PROCEDURE Pos*(VAR r:Rider):LONGINT;
  441.     Get the position of a rider.
  442. BEGIN
  443.     RETURN r.org+r.offset
  444. END Pos;
  445. PROCEDURE Set*(VAR r:Rider; f:File; pos:LONGINT);
  446.     Set the rider to a specific position within the file.
  447.     buf:Buffer;
  448.     err:ARRAY 25 OF CHAR;
  449.     org,offset,i,n,errno:LONGINT;
  450.     workName,registerName:FileName;
  451. BEGIN
  452.     IF pos>f.len THEN pos:=f.len ELSIF pos<0 THEN pos:=0 END;
  453.     offset:=pos MOD bufsize; org:=pos-offset; i:=0;
  454.     WHILE (i<nofbufs) & (f.bufs[i]#NIL) & (org#f.bufs[i].org) DO INC(i) END;
  455.     IF i<nofbufs THEN
  456.         IF f.bufs[i]=NIL THEN NEW(buf); buf.chg:=FALSE; buf.org:=-1; buf.f:=f; f.bufs[i]:=buf; (* found empty buffer slot. *)
  457.         ELSE buf:=f.bufs[i]; (* found buffer which contains position. *)
  458.         END
  459.     ELSE
  460.             All slots used, but none containing the requested position.
  461.             Swap out one of the buffers.
  462.         f.swapper:=(f.swapper+1) MOD nofbufs;
  463.         buf:=f.bufs[f.swapper];
  464.         Flush(buf)
  465.     END;
  466.     IF buf.org#org THEN
  467.             A new buffer was selected. If the selected position is at the
  468.             end of the file, just an empty buffer is initialized. Otherwise,
  469.             the buffer is loaded from the file.
  470.         IF org=f.len THEN
  471.             buf.size:=0
  472.         ELSE
  473.             Create(f);
  474.             IF f.pos#org THEN n:=Dos.Seek(f.fd,org,Dos.beginning) END;
  475.             n:=Dos.Read(f.fd,buf.data,bufsize);
  476.             IF n<0 THEN errno:=Dos.IoErr();
  477.                 IF ~Dos.NameFromLock(f.fl,workName) THEN workName:="" END;
  478.                 registerName:=f.registerName;
  479.                 err:="read not done"; HALT(99)
  480.             END;
  481.             f.pos:=org+n;
  482.             buf.size:=n
  483.         END;
  484.         buf.org:=org; buf.chg:=FALSE
  485.     END;
  486.     r.buf:=buf; r.org:=org; r.offset:=offset; r.eof:=FALSE; r.res:=0
  487. END Set;
  488. PROCEDURE Read*(VAR r:Rider; VAR x:SYSTEM.BYTE);
  489.     buf:Buffer;
  490.     offset:LONGINT;
  491. BEGIN
  492.     buf:=r.buf; offset:=r.offset;
  493.     IF r.org#buf.org THEN Set(r,buf.f,r.org+offset); buf:=r.buf; offset:=r.offset END;
  494.     IF (offset<buf.size) THEN
  495.         x:=buf.data[offset]; r.offset:=offset+1
  496.     ELSIF r.org+offset<buf.f.len THEN
  497.         Set(r,r.buf.f,r.org+offset);
  498.         x:=r.buf.data[0]; r.offset:=1
  499.     ELSE
  500.         x:=0X; r.eof:=TRUE
  501. END Read;
  502. PROCEDURE ReadBytes*(VAR r:Rider; VAR x:ARRAY OF SYSTEM.BYTE; n:LONGINT);
  503.     buf:Buffer;
  504.     xpos,min,restInBuf,offset:LONGINT;
  505. BEGIN
  506.     IF n>LEN(x) THEN HALT(43) END;
  507.     xpos:=0; buf:=r.buf; offset:=r.offset;
  508.     WHILE n>0 DO
  509.         IF (r.org#buf.org) OR (offset>=bufsize) THEN
  510.             Set(r,buf.f,r.org+offset);
  511.             buf:=r.buf; offset:=r.offset
  512.         END;
  513.         restInBuf:=buf.size-offset;
  514.         IF restInBuf=0 THEN r.res:=n; r.eof:=TRUE; RETURN
  515.         ELSIF n>restInBuf THEN min:=restInBuf
  516.         ELSE min:=n
  517.         END;
  518.         SYSTEM.MOVE(SYSTEM.ADR(buf.data)+offset,SYSTEM.ADR(x)+xpos,min);
  519.         INC(offset,min); r.offset:=offset; INC(xpos,min); DEC(n,min)
  520.     END;
  521.     r.res:=0; r.eof:=FALSE
  522. END ReadBytes;
  523. PROCEDURE Base*(VAR r:Rider):File;
  524.     Get the file on which this rider is based.
  525. BEGIN
  526.     RETURN r.buf.f
  527. END Base;
  528. PROCEDURE Write*(VAR r:Rider; x:SYSTEM.BYTE);
  529.     buf:Buffer;
  530.     offset:LONGINT;
  531. BEGIN
  532.     buf:=r.buf; offset:=r.offset;
  533.     IF (r.org#buf.org) OR (offset>=bufsize) THEN
  534.         Set(r,buf.f,r.org+offset);
  535.         buf:=r.buf; offset:=r.offset
  536.     END;
  537.     buf.data[offset]:=x;
  538.     buf.chg:=TRUE;
  539.     IF offset=buf.size THEN
  540.         INC(buf.size); INC(buf.f.len)
  541.     END;
  542.     r.offset:=offset+1; r.res:=0
  543. END Write;
  544. PROCEDURE WriteBytes*(VAR r:Rider; VAR x:ARRAY OF SYSTEM.BYTE; n:LONGINT);
  545.     xpos,min,restInBuf,offset:LONGINT;
  546.     buf:Buffer;
  547. BEGIN
  548.     IF n>LEN(x) THEN HALT(43) END;
  549.     xpos:=0; buf:=r.buf; offset:=r.offset;
  550.     WHILE n>0 DO
  551.         IF (r.org#buf.org) OR (offset>=bufsize) THEN
  552.             Set(r,buf.f,r.org+offset);
  553.             buf:=r.buf; offset:=r.offset
  554.         END;
  555.         restInBuf:=bufsize-offset;
  556.         IF n>restInBuf THEN min:=restInBuf ELSE min:=n END;
  557.         SYSTEM.MOVE(SYSTEM.ADR(x)+xpos,SYSTEM.ADR(buf.data)+offset,min);
  558.         INC(offset,min); r.offset:=offset;
  559.         IF offset>buf.size THEN INC(buf.f.len,offset-buf.size); buf.size:=offset END;
  560.         INC(xpos,min); DEC(n,min); buf.chg:=TRUE
  561.     END;
  562.     r.res:=0
  563. END WriteBytes;
  564. PROCEDURE Register*(f:File);
  565.     errno:INTEGER;
  566.     file:FileName;
  567. BEGIN
  568.     IF (f.state=create) & (f.registerName#"") THEN f.state:=close (* shortcut renaming *) END;
  569.     Close(f);
  570.     IF f.registerName#"" THEN
  571.         IF ~Dos.NameFromLock(f.fl,file) THEN file:="" END;
  572.         Rename(file,f.registerName,errno);
  573.         IF errno#0 THEN COPY(f.registerName,file); HALT(100) END;
  574.         f.registerName:=""
  575. END Register;
  576. PROCEDURE ChangeDirectory*(path:ARRAY OF CHAR; VAR res:INTEGER);
  577.     lock,oldLock:Dos.FileLockPtr;
  578. BEGIN
  579.     lock:=Dos.Lock(path,Dos.sharedLock);
  580.     IF lock#0 THEN
  581.         oldLock:=Dos.CurrentDir(lock);
  582.         Dos.UnLock(oldLock);
  583.         IF Dos.NameFromLock(lock,CurrentDir) THEN END;
  584.         res:=noError
  585.     ELSE
  586.         res:=directoryNotFound
  587. END ChangeDirectory;
  588. (*----------------- Files1 ----------------*)
  589.     little endian,
  590.     ORD({0})=1,
  591.     false=0,true =1
  592.     IEEE real format,
  593.     null terminated strings,
  594.     compact format according to M.Odersky
  595. PROCEDURE FlipBytes(VAR src,dest:ARRAY OF SYSTEM.BYTE);
  596.     i,j:LONGINT;
  597. BEGIN
  598.     j:=0;
  599.     FOR i:=LEN(src)-1 TO 0 BY -1 DO dest[j]:=src[i]; INC(j) END
  600. END FlipBytes;
  601. PROCEDURE ReadBool*(VAR R:Rider; VAR x:BOOLEAN);
  602. BEGIN
  603.     Read(R,SYSTEM.VAL(CHAR,x))
  604. END ReadBool;
  605. PROCEDURE ReadInt*(VAR R:Rider; VAR x:INTEGER);
  606.     b:ARRAY 2 OF CHAR;
  607. BEGIN
  608.     ReadBytes(R,b,2);
  609.     x:=ORD(b[0])+ORD(b[1])*256
  610. END ReadInt;
  611. PROCEDURE ReadLInt*(VAR R:Rider; VAR x:LONGINT);
  612.     b:ARRAY 4 OF CHAR;
  613. BEGIN
  614.     ReadBytes(R,b,4);
  615.     x:=LONG(ORD(b[0]))+LONG(ORD(b[1]))*100H+LONG(ORD(b[2]))*10000H+LONG(ORD(b[3]))*1000000H
  616. END ReadLInt;
  617. PROCEDURE ReadSet*(VAR R:Rider; VAR x:SET);
  618.     b:ARRAY 4 OF CHAR;
  619.     s2,s3:SET;
  620.     i:LONGINT;
  621. BEGIN
  622.     IF BigEndianSet THEN
  623.         ReadBytes(R,b,4);
  624.         s2:=SYSTEM.VAL(SET,LONG(ORD(b[0]))+LONG(ORD(b[1]))*100H +
  625.         LONG(ORD(b[2]))*10000H +LONG(ORD(b[3]))*1000000H);
  626.         s3:={};
  627.         FOR i:=0 TO 31 DO
  628.             IF i IN s2 THEN INCL(s3,31-i) END
  629.         END;
  630.         x:=s3
  631.     ELSE
  632.         IF BigEndianMachine THEN ReadBytes(R,b,4); FlipBytes(b,x)
  633.         ELSE ReadBytes(R,x,4)
  634.         END
  635. END ReadSet;
  636. PROCEDURE ReadReal*(VAR R:Rider; VAR x:REAL);
  637.     b:ARRAY 4 OF CHAR;
  638. BEGIN
  639.     IF BigEndianMachine THEN ReadBytes(R,b,4); FlipBytes(b,x)
  640.     ELSE ReadBytes(R,x,4)
  641. END ReadReal;
  642. PROCEDURE ReadLReal*(VAR R:Rider; VAR x:LONGREAL);
  643.     b:ARRAY 8 OF CHAR;
  644. BEGIN
  645.     IF BigEndianMachine THEN ReadBytes(R,b,8); FlipBytes(b,x)
  646.     ELSE ReadBytes(R,x,8)
  647. END ReadLReal;
  648. PROCEDURE ReadString*(VAR R:Rider; VAR x:ARRAY OF CHAR);
  649.     i:INTEGER;
  650.     ch:CHAR;
  651. BEGIN
  652.     i:=0; REPEAT Read(R,ch); x[i]:=ch; INC(i) UNTIL ch=0X
  653. END ReadString;
  654. PROCEDURE ReadNum*(VAR R:Rider; VAR x:LONGINT);
  655.     ch:CHAR;
  656.     n:LONGINT;
  657.     s:SHORTINT;
  658. BEGIN
  659.     s:=0; n:=0; Read(R,ch);
  660.     WHILE ORD(ch)>=128 DO INC(n,ASH(LONG(ORD(ch))-128,s) ); INC(s,7); Read(R,ch) END;
  661.     x:=n+ASH(LONG(ORD(ch)) MOD 64-ORD(ch) DIV 64*64,s)
  662. END ReadNum;
  663. PROCEDURE WriteBool*(VAR R:Rider; x:BOOLEAN);
  664. BEGIN
  665.     Write(R,SYSTEM.VAL(CHAR,x))
  666. END WriteBool;
  667. PROCEDURE WriteInt*(VAR R:Rider; x:INTEGER);
  668.     b:ARRAY 2 OF CHAR;
  669. BEGIN
  670.     b[0]:=CHR(x); b[1]:=CHR(x DIV 256);
  671.     WriteBytes(R,b,2)
  672. END WriteInt;
  673. PROCEDURE WriteLInt*(VAR R:Rider; x:LONGINT);
  674.     b:ARRAY 4 OF CHAR;
  675. BEGIN
  676.     b[0]:=CHR(x); b[1]:=CHR(x DIV 100H); b[2]:=CHR(x DIV 10000H); b[3]:=CHR(x DIV 1000000H);
  677.     WriteBytes(R,b,4)
  678. END WriteLInt;
  679. PROCEDURE WriteSet*(VAR R:Rider; x:SET);
  680.     b:ARRAY 4 OF CHAR; i:LONGINT; s2:SET;
  681. BEGIN
  682.     IF BigEndianSet THEN
  683.         s2:={};
  684.         FOR i:=0 TO 31 DO
  685.             IF i IN x THEN INCL(s2,31-i) END
  686.         END;
  687.         i:=SYSTEM.VAL(LONGINT,s2);
  688.         b[0]:=CHR(i); b[1]:=CHR(i DIV 100H); b[2]:=CHR(i DIV 10000H); b[3]:=CHR(i DIV 1000000H);
  689.         WriteBytes(R,b,4)
  690.     ELSE
  691.         IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,4)
  692.         ELSE WriteBytes(R,x,4)
  693.         END
  694. END WriteSet;
  695. PROCEDURE WriteReal*(VAR R:Rider; x:REAL);
  696.     b:ARRAY 4 OF CHAR;
  697. BEGIN
  698.     IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,4)
  699.     ELSE WriteBytes(R,x,4)
  700. END WriteReal;
  701. PROCEDURE WriteLReal*(VAR R:Rider; x:LONGREAL);
  702.     b:ARRAY 8 OF CHAR;
  703. BEGIN
  704.     IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,8)
  705.     ELSE
  706.         WriteBytes(R,x,8)
  707. END WriteLReal;
  708. PROCEDURE WriteString*(VAR R:Rider; x:ARRAY OF CHAR);
  709.     i:INTEGER;
  710. BEGIN
  711.     i:=0; WHILE x[i]#0X DO INC(i) END;
  712.     WriteBytes(R,x,i+1)
  713. END WriteString;
  714. PROCEDURE WriteNum*(VAR R:Rider; x:LONGINT);
  715. BEGIN
  716.     WHILE (x<-64) OR (x>63) DO Write(R,CHR(x MOD 128+128)); x:=x DIV 128 END;
  717.     Write(R,CHR(x MOD 128))
  718. END WriteNum;
  719. PROCEDURE Finalize(obj:SYSTEM.PTR);
  720.     file:File;
  721.     pref:FileName;
  722.     name:FileName;
  723. BEGIN
  724.     file:=SYSTEM.VAL(File,obj);
  725.     ASSERT(file#NIL);
  726.     IF ~Dos.NameFromLock(file.fl,name) THEN name:="" END;
  727.     IF file.fl#0 THEN
  728.         Dos.UnLock(file.fl);
  729.         file.fl:=0
  730.     END;
  731.     IF file.fd#noDesc THEN
  732.         SeekAndExtend(file.fd,file.len);
  733.         IF Dos.Close(file.fd) THEN END;
  734.         file.fd:=noDesc
  735.     END;
  736.     IF file.idx>=0 THEN
  737.         DEC(Kernel.nofiles);
  738.         fileTab[file.idx]:=0
  739.     END;
  740.         test for ".tmp." in first 5 chars and call Dos.Deletefile in
  741.         this case.
  742.     Dos.FilePart(name,pref);
  743.     pref[5]:=0X;
  744.     IF pref=".tmp." THEN
  745.         IF ~Dos.DeleteFile(name) THEN
  746.         END
  747. END Finalize;
  748. PROCEDURE Init;
  749.     i:LONGINT;
  750.     lock:Dos.FileLockPtr;
  751. BEGIN
  752.     I.CurrentTime(startTime,i);
  753.     tempno:=-1;
  754.     lock:=Dos.Lock("",Dos.sharedLock);
  755.     IF ~Dos.NameFromLock(lock,CurrentDir) THEN CurrentDir:="" END;
  756.     Dos.UnLock(lock);
  757.     FOR i:=0 TO fileTabSize-1 DO fileTab[i]:=0 END;
  758.     Kernel.nofiles:=0;
  759.     Amiga.GetSearchPath(searchPath)
  760. END Init;
  761. BEGIN
  762.     Init
  763. END Files.
  764.